home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / match < prev    next >
Encoding:
Text File  |  1987-02-26  |  1.1 KB  |  46 lines
  1.  
  2. \ proper match for case-sensitive/insensitive systems
  3.  
  4. user mcase-sensitive       \ default = false
  5.  
  6. : upperc@  ( addr -- upper-case )
  7.   c@ dup ?letter
  8.   IF   $ df and
  9.   THEN
  10. ;
  11.  
  12. : text=?  ( a1 cnt a2 -- flag )  swap -dup
  13.   IF   over + swap   mcase-sensitive @
  14.        IF   DO   dup c@  i c@ -
  15.                  IF   0= leave
  16.                  ELSE 1+
  17.                  THEN
  18.             LOOP
  19.        ELSE DO   dup upperc@  i upperc@ -
  20.                  IF   0= leave
  21.                  ELSE 1+
  22.                  THEN
  23.             LOOP
  24.        THEN
  25.   ELSE 2drop false
  26.   THEN
  27. ;
  28.  
  29. \ I gave this a new name 'cause it does the stack differently that fig MATCH.
  30. : match? ( adr1 c1 adr2 c2 -- matching-a1 / 0 )
  31. \ search for adr2 cnt2 within adr1 cnt1
  32.   4 x>r   0   4 xr>   ( 0 a1 c1 a2 c2 -- )
  33.   2swap over + swap   ( 0 a2 c2 enda1 a1 -- )
  34.   DO   2dup i  ( 0 a2 c2 a2 c2 a1 -- )
  35.        text=?  ( 0 a2 c2 flag -- )
  36.        IF      3 xdrop i 0 0    leave   ( a1 x x -- )
  37.        THEN
  38.   LOOP 2drop
  39. ;
  40.  
  41. \ : trytext  sp!
  42. \   bl lword pad $move     bl lword count pad 1+ text=?  ;
  43.  
  44. \ : trymatch  sp!
  45. \   bl lword pad $move     bl lword count  pad count match?   here .s  ;
  46.